home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.51 / zmorev0.16 / zmorev0.16.p < prev    next >
Text File  |  1995-08-27  |  14KB  |  551 lines
  1. { Programm: ZMore
  2.  
  3.   Version:  0.16 / 12.08.95
  4.  
  5.   Sprache:  KickPascal 2.12/OS3.1-Includes
  6.  
  7.   Sinn:     einfaches Textanzeigen mit Tastaturunterst.
  8.  
  9.   ©:        Gilt nur als Mittel des Autors bei Sharware/Lowcost-
  10.             Programmen von ihm andere Anzeiger zu meiden, um damit
  11.             deren Copyright nicht zu verletzen.
  12.  
  13.   Autor:    PackMAN
  14.             c/o Falk Zühlsdorff
  15.             Lindenberg 66
  16.             D-98693 Ilmenau / Thüringen
  17.  
  18.  
  19.             email: ai036@rz.tu-ilmenau.de                           }
  20.  
  21.  
  22. Program ZMore;
  23.  
  24. {$incl 'intuition.lib',
  25.        'graphics.lib',
  26.        'exec.lib',
  27.        'gadtools.lib',
  28.        'dos.lib',
  29.        'workbench/startup.h'};
  30.  
  31. TYPE p_ZNode = ^ZNode;
  32.      ZNode = RECORD
  33.       ln_Succ : p_ZNode;
  34.       ln_Pred : p_ZNode;
  35.       ln_Type : Byte;
  36.       ln_Pri  : Short;
  37.       ln_Name : ^String;
  38.      END;
  39.  
  40.      ZList = RECORD
  41.       mlh_Head     : p_ZNode;
  42.       mlh_Tail     : p_ZNode;
  43.       mlh_TailPred : p_ZNode;
  44.      END;
  45.  
  46.      pointerfeld = array[1..40] of Word;
  47.  
  48.      penfeld     = ^array[0..7] OF   Word;        { brauche nur BG-Pen }
  49.  
  50. VAR  Win               : p_Window;
  51.      Tags              : array[0..7] of TagItem;  { Win / LV-Gadget }
  52.      ZMsg              : p_IntuiMessage;
  53.  
  54.      ng                : NewGadget;
  55.      G,PropGad         : p_Gadget;
  56.  
  57.      dummy             : boolean;                 {z.B. für Exit}
  58.  
  59.      myfile            : text;
  60.  
  61.      FirstDs,
  62.      LastDs            : p_ZNode;
  63.  
  64.      ZeilenAnz,                                   {Zeilen d. Dokumentes}
  65.      AktPos            : LONG;
  66.      FileName          : String[165];
  67.  
  68.      mylist            : Zlist;
  69.  
  70.      MyPropInfo        : p_propinfo;
  71.      LVZeilen          : word;                    {sichbare Zeilen}
  72.  
  73.     {-------------------- WBScreen / Font... ----------------------}
  74.  
  75.      lib               : p_library;
  76.      WBScr             : p_screen;
  77.      di                : p_drawinfo;
  78.  
  79.      cm                : p_ColorMap;              {für ScrVisible}
  80.      vpe               : p_ViewPortExtra;
  81.  
  82.      Pens              : penfeld;
  83.  
  84.      vi                : PTR;
  85.      txattr            : TextAttr;
  86.      font              : p_textfont;
  87.      ysize,xsize,i     : word;
  88.  
  89.      zeichen           : char;
  90.  
  91.      GList             : p_Gadget;
  92.  
  93.      Pointerptr        : ^Pointerfeld;
  94.      waitreq           : Requester;
  95.  
  96. {--------------------------------------------------------------------}
  97.  
  98. PROCEDURE Error(Tx:string);
  99. VAR ErrorTextAttr : TextAttr;
  100.     ITx,ITxGad    : IntuiText;
  101.     dummy         : boolean;
  102. BEGIN
  103.  ErrorTextAttr:=TextAttr('topaz.font',8,0,0);
  104.  ITx:=IntuiText(2,0,0,20,10,^ErrorTextAttr,Tx,NIL);
  105.  ITxGad:=IntuiText(2,0,0,2,3,^ErrorTextAttr,'OK',NIL);
  106.  dummy:=AutoRequest(NIL,^ITx,NIL,^ITxGad,0,0,330,80);
  107. END;
  108. {--------------------------------------------------------------------}
  109. PROCEDURE CloseMisc;
  110. VAR Misc : p_ZNode;
  111. BEGIN
  112.  IF Win<>NIL           THEN CloseWindow(Win);
  113.  IF PointerPTR<>NIL    THEN FreeVec(PointerPTR);
  114.  IF vi<>NIL            THEN FreeVisualInfo(vi);
  115.  IF IntuitionBase<>NIL THEN CloseLibrary(IntuitionBase);
  116.  IF GfxBase<>NIL       THEN CloseLibrary(GfxBase);
  117.  IF Gadtoolsbase<>NIL  THEN CloseLibrary(Gadtoolsbase);
  118.  
  119.  WHILE FirstDs<>LastDs^.ln_succ DO
  120.   BEGIN
  121.    Misc:=FirstDs^.ln_succ;
  122.    FreeVec(FirstDs^.ln_name);
  123.    Dispose(FirstDs);
  124.    FirstDs:=Misc;
  125.   END;
  126.  
  127. END;
  128. {------------------------------------------------------------------------}
  129. PROCEDURE GetWBArgs;
  130.  
  131. VAR WBMsg     : p_WBStartup;
  132.     help      : integer;STATIC;
  133.     helpstr   : String;STATIC;
  134.  
  135. BEGIN
  136.  helpstr:='';
  137.  WBMsg:=StartupMessage;
  138.  IF WBMsg^.sm_NumArgs<2
  139.   THEN BEGIN FileName:=''; exit; END;
  140.  
  141.  help:=NameFromLock(WBMsg^.sm_ArgList^[2].wa_lock,^Helpstr,80);
  142.  
  143.  IF (HelpStr[Length(HelpStr)])<>':'
  144.   THEN FileName:=Concat(HelpStr,'/',WBMsg^.sm_ArgList^[2].wa_name)
  145.   ELSE FileName:=Concat(HelpStr,WBMsg^.sm_ArgList^[2].wa_name);
  146. END;
  147. {--------------------------------------------------------------------}
  148. PROCEDURE GetCliArgs;
  149.  
  150. VAR ParaSTR    : String;STATIC;
  151.     ParaLen    : byte;STATIC;
  152.     first,raus : boolean;STATIC;
  153.  
  154. BEGIN
  155.  FileName:='';
  156.  IF ParameterSTR<>''
  157.   THEN
  158.    BEGIN
  159.     ParaSTR:='';
  160.     ParaSTR:=Copy(ParameterStr,1,ParameterLen);
  161.     ParaLen:=1;
  162.     first:=true;
  163.     raus:=false;
  164.     WHILE (ParaLen<=ParameterLen)     AND (raus=false) AND
  165.           (ParaStr[ParaLen]<>chr(10)) DO
  166.      BEGIN
  167.       IF ParaSTR[ParaLen]<>' '
  168.        THEN
  169.         BEGIN
  170.          IF first THEN first:=false;
  171.          FileName:=FileName+ParaSTR[ParaLen];
  172.         END
  173.        ELSE IF first=false THEN raus:=true;
  174.       INC(ParaLen)
  175.      END;
  176.    END;
  177. END;
  178. {---------------------------------------------------------------------}
  179. PROCEDURE AddDs;
  180. VAR neu    : p_ZNode;
  181.     data   : string[74];
  182. BEGIN
  183.  new(neu);
  184.  IF neu=NIL
  185.   THEN dummy:=false
  186.   ELSE
  187.    BEGIN
  188.     read(myfile,data);
  189.     IF data='' THEN data:=' ';
  190.     neu^.ln_name:=AllocVec(strlen(data),MEMF_ANY);
  191.     IF neu^.ln_name=NIL
  192.      THEN dummy:=false
  193.      ELSE
  194.       BEGIN
  195.        neu^.ln_name^:=data;
  196.        neu^.ln_succ:=^mylist.mlh_tail;
  197.        neu^.ln_type:=0;
  198.        neu^.ln_pri:=0;
  199.        IF LastDs=NIL
  200.         THEN
  201.          BEGIN
  202.           neu^.ln_pred:=^mylist.mlh_head;
  203.           FirstDs:=neu;
  204.          END
  205.         ELSE
  206.          BEGIN
  207.           lastds^.ln_succ:=neu;
  208.           neu^.ln_pred:=LastDs;
  209.          END;
  210.        LastDs:=neu;
  211.        INC(ZeilenAnz);
  212.       END;
  213.    END;
  214. END;
  215. {---------------------------------------------------------------------}
  216. PROCEDURE Jump(Weite,wohin:LONG);
  217. VAR EndNum:LONG;STATIC;
  218. BEGIN
  219.  CASE wohin OF
  220.   1: IF AktPos-Weite>=0                  THEN EndNum:=AktPos-Weite
  221.                                          ELSE EndNum:=0;
  222.   2: IF AktPos+Weite<=ZeilenAnz-LVZeilen THEN EndNum:=AktPos+Weite
  223.                                          ELSE EndNum:=ZeilenAnz-LVZeilen;
  224.   3: EndNum:=Weite;
  225.  ELSE;END;
  226.  Tags[2]:=TagItem(GTLV_Top,EndNum);
  227.  GT_SetGadgetAttrsA(g,Win,NIL,^Tags[2]);
  228. END;
  229. {--------------------------------------------------------------------}
  230.  FUNCTION ListView:boolean;
  231.  BEGIN
  232.   GList:=NIL;G:=NIL;PropGad:=NIL; MyPropInfo:=NIL;
  233.  
  234.   GList:=CreateContext(^GList);
  235.   IF GList=NIL
  236.    THEN ListView:=False
  237.    ELSE
  238.     BEGIN
  239.      LVZeilen:=
  240.       TRUNC((Win^.GZZHeight-3)/ysize)-1;
  241.  
  242.      ng:=NewGadget(Win^.BorderLeft+TRUNC(xsize/2),
  243.           Win^.BorderTop+TRUNC((Win^.GZZHeight-((LVZeilen+1)*ysize))/2)+1,
  244.           Win^.GZZWidth-xsize,(LVZeilen+1)*ysize,
  245.           NIL,^Txattr,0,0,vi,NIL);
  246.  
  247.      g:=CreateGadgetA(LISTVIEW_KIND,GList,^ng,^Tags[0]);
  248.  
  249.      PropGad:=GList^.NextGadget^.NextGadget;
  250.  
  251.       {-------- OS2 <--> OS3 Gadtools-Inkompatibilität ---------}
  252.  
  253.       IF lib^.lib_version<39
  254.        THEN FOR i:=1 TO LVZeilen-1 DO PropGad:=PropGad^.NextGadget;
  255.  
  256.       {---------------------------------------------------------}
  257.  
  258.      MyPropInfo:=PropGad^.SpecialInfo;
  259.  
  260.      MyPropInfo^.Flags:= MyPropInfo^.Flags+PROPNEWLOOK;
  261.  
  262.      i:=AddGList(Win,GList,-1,-1,NIL);
  263.      RefreshGList(Win^.FirstGadget^.NextGadget^.NextGadget
  264.                      ^.NextGadget^.NextGadget,Win,nil,-1);
  265.  
  266.      GT_RefreshWindow(Win,NIL);
  267.  
  268.      RefreshWindowFrame(Win);
  269.  
  270.      ListView:=True;
  271.  
  272.     END;
  273.  END;
  274. {---------------------------------------------------------------------}
  275. BEGIN
  276.  lib:=sysbase;
  277.  
  278.  IF lib^.lib_version<37
  279.   THEN BEGIN Error('Needs OS2.x or higher !'); exit;END;
  280.  
  281.  IntuitionBase:=OpenLibrary('intuition.library',37);
  282.  GfxBase:=OpenLibrary('graphics.library',37);
  283.  Gadtoolsbase:=OpenLibrary('gadtools.library',37);
  284.  
  285.  IF (GfxBase=NIL) OR (IntuitionBase=NIL) OR (Gadtoolsbase=NIL)
  286.   THEN CloseMisc;
  287.  
  288.  {---- Anpassung auf sichbaren Bildschirmausschnitt ----}
  289.  
  290.  WBScr:=NIL; FirstDs:=NIL;LastDs:=NIL;ZeilenAnz:=0;
  291.  
  292.  WBScr:=lockpubscreen('Workbench');
  293.  IF WBScr<>NIL
  294.   THEN
  295.    BEGIN
  296.     di:=NIL;
  297.     cm:=NIL;
  298.     vpe:=NIL;
  299.     Win:=NIL;
  300.  
  301.     cm:=WBScr^.ViewPort.ColorMap;
  302.     vpe:=cm^.cm_vpe;
  303.     di:=getscreendrawinfo(WBScr);
  304.  
  305.     IF (di<>NIL) AND (cm<>NIL) AND (vpe<>NIL)
  306.      THEN
  307.       BEGIN
  308.        Pens:=penfeld(di^.dri_Pens);
  309.  
  310.        font:=di^.dri_font;
  311.        xsize:=0;
  312.  
  313.        FOR zeichen:=chr($00) TO chr($5E) DO
  314.          i:=i+textlength(^WBScr^.rastport,zeichen,1);{Mißbrauch}
  315.        i:=i+textlength(^WBScr^.rastport,' ',1);
  316.        xsize:=TRUNC(i/96);
  317.  
  318.        ysize:=font^.tf_ysize;
  319.  
  320.        txattr:=TextAttr(di^.dri_font^.tf_Message.mn_Node.ln_Name,
  321.                         ysize,0,0);
  322.        vi:=GetVisualinfoA(WBScr,nil);
  323.        freescreendrawinfo(WBScr,di);
  324.  
  325.        UnlockPubScreen(NIL,WBScr);
  326.  
  327.        IF (vpe^.DisplayClip.MaxX+1<(80*xsize)) OR
  328.           (vpe^.DisplayClip.MaxY+1<
  329.           (WBScr^.WBorBottom+WBScr^.WBorTop+1+14*ysize))
  330.        THEN
  331.         BEGIN
  332.          ysize:=8;
  333.          xsize:=8;
  334.          txattr:=TextAttr('topaz.font',ysize,0,0);
  335.          Font:=OpenFont(^txattr);
  336.         END
  337.  
  338.       END
  339.      ELSE
  340.       BEGIN
  341.        Error('Can`t run program...');
  342.        CloseMisc;
  343.        exit;
  344.       END;
  345.    END
  346.   ELSE   {für den Fall, daß alles zu spät ist...}
  347.    BEGIN
  348.     Error('Can`t find WBench-Screen');
  349.     exit;
  350.    END;
  351.  
  352.   PointerPTR:=NIL;
  353.   PointerPTR:=PTR(AllocVec(SizeOf(pointerfeld),MEMF_CHIP+MEMF_CLEAR));
  354.   IF PointerPTR=NIL
  355.    THEN BEGIN CloseMisc; exit;END;
  356.  
  357.   PointerPTR^:=Pointerfeld
  358.   ($0000,$0000,$0400,$07c0,$0000,$07c0,$0100,$0380,
  359.    $0000,$07e0,$07c0,$1ff8,$1ff0,$3fec,$3ff8,$7fde,
  360.    $3ff8,$7fbe,$7ffc,$ff7f,$7efc,$ffff,$7ffc,$ffff,
  361.    $3ff8,$7ffe,$3ff8,$7ffe,$1ff0,$3ffc,$07c0,$1ff8,
  362.    $0000,$07e0,$0000,$0000,$0000,$03f2,$0000,$0000);
  363.  
  364.  LVZeilen:=TRUNC((vpe^.DisplayClip.MaxY-(3*ysize)-WBScr^.WBorTop-
  365.                   WBScr^.WBorBottom)/ysize);        { Vorabwert }
  366.  
  367.  {---- Begin des Einlesens d. Files -----}
  368.  
  369.  IF NOT FROMWB
  370.   THEN
  371.    BEGIN
  372.     GetCliArgs;
  373.     IF FileName=''
  374.      THEN
  375.       BEGIN
  376.        writeln('No file to display...'); writeln;
  377.        CloseMisc;
  378.        exit;
  379.       END;
  380.    END
  381.   ELSE
  382.    BEGIN
  383.     GetWBArgs;
  384.     IF FileName=''
  385.      THEN
  386.       BEGIN Error('ZMore: No file to display');CloseMisc;exit;END;
  387.    END;
  388.  
  389.  Reset(myfile,FileName);
  390.  IF IOResult<>0
  391.   THEN
  392.    BEGIN
  393.     IF NOT FROMWB
  394.      THEN writeln('Can`t open file...')
  395.      ELSE Error('ZMore: Can`t open file...');
  396.     CloseMisc;
  397.     exit;
  398.    END;
  399.  
  400.  dummy:=true;
  401.  
  402.  buffer(myfile,50000);  { Speedupbuffer }
  403.  
  404.  WHILE (NOT EOF(myfile) AND (dummy)) AND (ZeilenAnz<LVZeilen) DO AddDs;
  405.  
  406.  mylist.mlh_head:=FirstDs;
  407.  mylist.mlh_tail:=NIL;
  408.  mylist.mlh_tailpred:=NIL;
  409.  
  410.  IF EOF(myfile) THEN BEGIN Close(myfile); dummy:=false END;
  411.  
  412.  AktPos:=0;
  413.  
  414.  Tags[0] :=Tagitem(wa_left,WBScr^.ViewPort.DxOffset*(-1));
  415.  Tags[1] :=Tagitem(wa_top,WBScr^.ViewPort.DyOffset*(-1));
  416.  Tags[2] :=Tagitem(wa_width,80*xsize);
  417.  Tags[3] :=Tagitem(wa_height,vpe^.DisplayClip.MaxY+1);
  418.  Tags[4].ti_tag:=wa_title;
  419.  Tags[4].ti_data:=
  420.   'ZMore V0.16 (c) by PackMAN (Falk Zühlsdorff) 12.08.95';
  421.  Tags[5] :=Tagitem(wa_idcmp,IDCMP_RAWKEY+IDCMP_CLOSEWINDOW+
  422.                             IDCMP_GADGETUP+IDCMP_GADGETDOWN+
  423.                             IDCMP_INTUITICKS+IDCMP_MOUSEBUTTONS+
  424.                             IDCMP_MOUSEMOVE+IDCMP_NEWSIZE);
  425.  Tags[6] :=Tagitem(wa_flags,WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+
  426.                             WFLG_WINDOWREFRESH+WFLG_ACTIVATE+
  427.                             WFLG_DRAGBAR+WFLG_SIZEBBOTTOM+
  428.                             WFLG_SIZEGADGET+WFLG_RMBTRAP);
  429.  
  430.  Tags[7].ti_tag:=tag_done;
  431.  
  432.  Win:=openwindowtaglist(nil,^Tags[0]);
  433.  
  434.  IF Win=NIL THEN BEGIN CloseMisc; exit END;
  435.  
  436.  Tags[0]:=TagItem(GTLV_ReadOnly,1);
  437.  Tags[1]:=TagItem(GTLV_Labels,long(^mylist));
  438.  Tags[2]:=TagItem(GTLV_Top,0);
  439.  Tags[3].ti_tag:=Tag_End;
  440.  
  441.  
  442.  IF NOT ListView THEN BEGIN CloseMisc; exit; END;
  443.  
  444.  IF dummy THEN
  445.   BEGIN
  446.    dummy:=WindowLimits(Win,80*xsize,vpe^.DisplayClip.MaxY+1,
  447.                            80*xsize,vpe^.DisplayClip.MaxY+1);
  448.  
  449.    {--- Init WaitReq ---}
  450.  
  451.    InitRequester(^waitReq);
  452.    dummy:=Request(^waitReq,Win);
  453.    SetPointer(Win,PointerPTR,16,16,-6,-1);
  454.  
  455.    {------------------}
  456.  
  457.    WHILE (NOT EOF(myfile) AND (dummy)) DO AddDs;
  458.  
  459.    GT_SetGadgetAttrsA(g,Win,NIL,^Tags[0]);
  460.  
  461.    {--- Clear WaitReq ---}
  462.  
  463.    ClearPointer(Win);
  464.    EndRequest(^waitReq,Win);
  465.  
  466.    {-----------------}
  467.  
  468.    Close(myfile);
  469.  
  470.   END;
  471.  
  472.    dummy:=WindowLimits(Win,3*win^.firstgadget^.nextgadget^.Width+2*xsize+
  473.                            textlength(^WBScr^.rastport,'ZMore',5),
  474.                            Win^.BorderTop+Win^.BorderBottom+8*ysize,
  475.                            WBScr^.ViewPort.DWidth,WBScr^.ViewPort.DHeight);
  476.  
  477.  dummy:=false;
  478.  
  479.  REPEAT
  480.   ZMsg:=Wait_Port(Win^.UserPort);
  481.   ZMsg:=GT_GetIMsg(Win^.Userport);
  482.  
  483.   IF (ZeilenAnz-LVZeilen)>0
  484.    THEN AktPos:=ROUND(MyPropInfo^.VertPot/(MAXBODY/(ZeilenAnz-LVZeilen)));
  485.  
  486.   CASE ZMsg^.class OF
  487.    IDCMP_CLOSEWINDOW : dummy:=true;
  488.    IDCMP_RAWKEY      :
  489.      CASE ZMsg^.Code OF
  490.       $45,
  491.       $10: dummy:=true;
  492.       $4C,
  493.       $3E: BEGIN                                       {up}
  494.             IF AktPos>0
  495.              THEN
  496.               IF (ZMsg^.Qualifier AND
  497.                  (IEQUALIFIER_LSHIFT OR IEQUALIFIER_RSHIFT))>0
  498.                THEN Jump(LVZeilen,1)
  499.                ELSE Jump(1,1);
  500.            END;
  501.       $4D,
  502.       $1E: BEGIN                                       {down}
  503.             IF AktPos<ZeilenAnz-LVZeilen
  504.              THEN
  505.               IF (ZMsg^.Qualifier AND
  506.                  (IEQUALIFIER_LSHIFT OR IEQUALIFIER_RSHIFT))>0
  507.                THEN Jump(LVZeilen,2)
  508.                ELSE Jump(1,2);
  509.            END;
  510.       $3D,
  511.       $14: IF AktPos>0 THEN Jump(0,3);                 {"Home"}
  512.       $1D,
  513.       $12: IF AktPos<ZeilenAnz-LVZeilen
  514.             THEN Jump(ZeilenAnz-LVZeilen,3)            {"End"}
  515.       $3F: IF AktPos>0 THEN Jump(LVZeilen,1);          {"PgUp"}
  516.       $1F: IF AktPos<ZeilenAnz-LVZeilen
  517.             THEN Jump(LVZeilen,2);                     {"PgDn"}
  518.  
  519.       $40,                                             {Space}
  520.       $43,                                             {Enter}
  521.       $44: IF (AktPos<ZeilenAnz) AND
  522.               (ZeilenAnz>LVzeilen) THEN Jump(1,2);     {Return}
  523.  
  524.      ELSE;END;
  525.    IDCMP_NEWSIZE:
  526.     BEGIN
  527.      SetAPen(Win^.RPort,Pens^[BACKGROUNDPEN]);
  528.      RectFill(Win^.RPort,Win^.BorderLeft,Win^.BorderTop,Win^.BorderLeft+
  529.               Win^.GZZWidth-1,Win^.BorderTop+Win^.GZZHeight-1);
  530.      i:=RemoveGList(Win,GList,-1);
  531.      FreeGadgets(glist);
  532.      IF NOT ListView THEN BEGIN CloseMisc; exit; END;
  533.     END;
  534.   ELSE;END;
  535.   GT_ReplyIMsg(ZMsg);
  536.  UNTIL dummy;
  537.  
  538.  CloseMisc;
  539.  FreeGadgets(Glist);
  540. END.
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.